Acoustic parameters mapped on phylogenies

Hummingbird song evolution

Loading packages

Reading data and setting global parameters

# color palette
cols <- viridis(10)

# ggplot2 theme
theme_set(theme_tree2(base_size = 14,base_family = "Arial"))

# main tree
hmm.swft.cpr.tree <- read.tree("data/processed/trees/consensus_tree_swifts_hummingbirds_and_nighjars_max_cred.tree")

## element acoustic parameters 
all.elm.acou.prm <- read.csv("data/processed/acoustic/Element parameters nighjars swifts and hummingbirds.csv", stringsAsFactors = FALSE)

all.elm.acou.prm$species <- gsub(" ", "_", all.elm.acou.prm$Species)

# song acoustic parameters
song.acoust.param <- read.csv("data/processed/acoustic/Song parameters nightjars swifts and hummingbirds.csv", stringsAsFactors = FALSE)

song.acoust.param$species <- song.acoust.param$species_uscr

# # complexity parameters
songs.complx.param <- read.csv("data/processed/acoustic/log10 songs complexity parameters nightjars swifts and hummingbirds.csv", stringsAsFactors = FALSE)

# formula for aggregating at the species level
frmla.elm <- as.formula(paste0("cbind(", paste(names(all.elm.acou.prm)[5:30], collapse = ", "), ") ~ species + Clade"))

frmla.sng <- as.formula(paste0("cbind(", paste(names(song.acoust.param)[c(11:35, 38:40)], collapse = ", "), ") ~ species + Clade"))

frmla.cmplx <- as.formula(paste0("cbind(", paste(names(songs.complx.param)[-1], collapse = ", "), ") ~ species + Clade"))

# aggregate all parameters
agg.elm.param.hmm <- agg.elm.param <- aggregate(frmla.elm, all.elm.acou.prm, mean)

agg.sng.param.hmm <- agg.sng.param <- aggregate(frmla.sng, song.acoust.param, mean)

songs.complx.param$Clade <- sapply(songs.complx.param$species, function(x) unique(all.elm.acou.prm$Clade[all.elm.acou.prm$species == x]))

agg.cmplx.param.hmm <- agg.cmplx.param <- aggregate(frmla.cmplx, songs.complx.param, mean)

# rename hummers
agg.elm.param$Clade <- ifelse(agg.elm.param$Clade %in% c("Nightjars", "Swifts"), agg.elm.param$Clade, "Hummingbirds")

agg.sng.param$Clade <- ifelse(agg.sng.param$Clade %in% c("Nightjars", "Swifts"), agg.sng.param$Clade, "Hummingbirds")

agg.cmplx.param$Clade <- ifelse(agg.cmplx.param$Clade %in% c("Nightjars", "Swifts"), agg.cmplx.param$Clade, "Hummingbirds")

# MRCAs for major clades
major.clade.nodes <- sapply(c("Nightjars", "Swifts", "Hummingbirds"), function(x) getMRCA(phy = hmm.swft.cpr.tree, tip = agg.elm.param$species[agg.elm.param$Clade == x]))

# remove no hummingbirds
agg.elm.param.hmm <- agg.elm.param.hmm[!agg.elm.param.hmm$Clade %in% c("Swifts", "Nightjars", "Patagona"), ]

agg.sng.param.hmm <- agg.sng.param.hmm[!agg.sng.param.hmm$Clade %in% c("Swifts", "Nightjars", "Patagona"), ]

agg.cmplx.param.hmm <- agg.cmplx.param.hmm[!agg.cmplx.param.hmm$Clade %in% c("Swifts", "Nightjars", "Patagona"), ]

# hummingbirds only tree
hmm.tree <- drop.tip(hmm.swft.cpr.tree, tip = setdiff(agg.elm.param$species, agg.elm.param.hmm$species))

# MRCAs for hummingbird subclade (excluding Patagona)
hmm.clade.nodes <- sapply(unique(agg.elm.param.hmm$Clade[agg.elm.param.hmm$Clade != "Patagona"]), function(x) getMRCA(phy = hmm.tree, tip = agg.elm.param.hmm$species[agg.elm.param.hmm$Clade == x]))

hmm.clade.nodes <- hmm.clade.nodes[order(names(hmm.clade.nodes))]

# base ggtree graph major clades  
gg.maj.clades <- ggtree(hmm.swft.cpr.tree, ladderize = FALSE) +
  theme_tree2() + 
  theme(text=element_text(size = 20))

# add color boxes
    for(i in 1:length(gg.maj.clades))
  gg.maj.clades <- gg.maj.clades + geom_hilight(node = major.clade.nodes[i], fill = cols[c(3, 6 ,9)][i]) 


# base ggtree graph hummingbird clades  
gg.hmm.clades <- ggtree(hmm.tree, ladderize = FALSE) +
  theme_tree2() + 
  theme(text=element_text(size = 20))
  
# color clades
  for(i in 1:length(hmm.clade.nodes))
  gg.hmm.clades <- gg.hmm.clades + geom_hilight(node = hmm.clade.nodes[i], fill = cols[i + 2]) 

# tree with 3 tips for the 3 major clades
major.clade.collapse.tree <- drop.tip(hmm.swft.cpr.tree, tip = setdiff(hmm.swft.cpr.tree$tip.label, agg.elm.param$species[!duplicated(agg.elm.param$Clade)]))

# rename tips
major.clade.collapse.tree$tip.label <- c("Nightjars", "Swifts", "Hummingbirds")

# base ggtree graph major clades  
gg.major.clade.collapse.tree <- ggtree(major.clade.collapse.tree, ladderize = FALSE) +
  theme_tree2() + 
  theme(text=element_text(size = 20))

# add colors to tips
 for(i in 1:Ntip(major.clade.collapse.tree))
  gg.major.clade.collapse.tree <- gg.major.clade.collapse.tree + geom_hilight(node = i, fill = cols[c(3 ,6, 9)][i]) 

gg.major.clade.collapse.tree <- gg.major.clade.collapse.tree +
  geom_label(aes(label = label), hjust = 1) 

### tree with 8  tips for hummer clades
hmm.clade.collapse.tree <- drop.tip(hmm.swft.cpr.tree, tip = setdiff(hmm.swft.cpr.tree$tip.label, agg.elm.param.hmm$species[!duplicated(agg.elm.param.hmm$Clade)]))

# rename tips
hmm.clade.collapse.tree$tip.label <- c("Hermits", "Topazes", "Mangoes", "Emeralds", "Mtn. Gems", "Bees", "Brilliants", "Coquettes")

# base ggtree graph major clades  
gg.hmm.clade.collapse.tree <- ggtree(hmm.clade.collapse.tree, ladderize = FALSE) +
  theme_tree2() + 
  theme(text=element_text(size = 20))

x <- 1
# add colors to tips
  for(i in order(hmm.clade.collapse.tree$tip.label, decreasing = FALSE))
  { gg.hmm.clade.collapse.tree <- gg.hmm.clade.collapse.tree + geom_hilight(node = i, fill = cols[3:10][x]) 
x <- x + 1
  }

## add tip labels
gg.hmm.clade.collapse.tree <- gg.hmm.clade.collapse.tree +
  geom_label(aes(label = label), hjust = 1) 

Element acoustic parameters

for(w in names(agg.elm.param)[-c(1, 2)]){

  print(w)
  
  # major clades
  gg.elm.prm <- gg.maj.clades
  gg.elm.prm <- facet_plot(gg.elm.prm, panel= w, data = agg.elm.param, geom = geom_point, aes(x = get(w), color =  Clade))  +
  scale_color_manual(values = cols[c(3, 9, 6)]) + 
    theme(legend.position = c(.15,.8), legend.background = element_rect(fill = "transparent"))
  
  # hummingbird clades
  gg.elm.prm.hmm <- gg.hmm.clades
  gg.elm.prm.hmm <- facet_plot(gg.elm.prm.hmm, panel = w, data = agg.elm.param.hmm, geom=geom_point, aes(x= get(w), color =  Clade))  +
  scale_color_manual(values = cols[c(3:10)]) +
    theme(legend.position = c(.1,.8),   legend.background = element_rect(fill = "transparent"))
  
### add violin plots  
  # major clades  
 # rename to avoid overwritting 
  gg.elm.prm.maj.clds <- gg.major.clade.collapse.tree
  agg.elm.param.maj.clds <- agg.elm.param
  
  # change species name
  agg.elm.param.maj.clds$species <- agg.elm.param.maj.clds$Clade
  
  # add facet violin
  gg.elm.prm.maj.clds <- facet_plot(gg.elm.prm.maj.clds, panel = w, data = agg.elm.param.maj.clds, geom = geom_violin, aes(x= get(w), group = label), fill = adjustcolor("gray", alpha.f = 0.5))  +
    theme(legend.position = c(.1,.9), legend.background = element_rect(fill = "transparent"))
  
  # hummingbird clades  
 # rename to avoid overwritting 
  gg.elm.prm.hmm.clds <- gg.hmm.clade.collapse.tree
  agg.elm.param.hmm.clds <- agg.elm.param.hmm
  
  # change species name
  agg.elm.param.hmm.clds$species <- agg.elm.param.hmm.clds$Clade
  
  # add facet violin
  gg.elm.prm.hmm.clds <- facet_plot(gg.elm.prm.hmm.clds, panel = w, data = agg.elm.param.hmm.clds, geom = geom_violin, aes(x= get(w), group = label), fill = adjustcolor("gray", alpha.f = 0.5))  +
    theme(legend.position = "none", legend.background = element_rect(fill = "transparent"))
  
 # plot both together
  print(plot_grid(gg.elm.prm, gg.elm.prm.hmm, gg.elm.prm.maj.clds, gg.elm.prm.hmm.clds, ncol = 2)) 

}

## [1] "duration"

## [1] "meanfreq"

## [1] "sd"

## [1] "freq.median"

## [1] "freq.Q25"

## [1] "freq.Q75"

## [1] "freq.IQR"

## [1] "time.median"

## [1] "time.Q25"

## [1] "time.Q75"

## [1] "time.IQR"

## [1] "skew"

## [1] "kurt"

## [1] "sp.ent"

## [1] "time.ent"

## [1] "entropy"

## [1] "sfm"

## [1] "meandom"

## [1] "mindom"

## [1] "maxdom"

## [1] "dfrange"

## [1] "modindx"

## [1] "startdom"

## [1] "enddom"

## [1] "dfslope"

## [1] "meanpeakf"

Song acoustic parameters

for(w in names(agg.sng.param)[-c(1, 2)]){

  print(w)
  
  # major clades
  gg.sng.prm <- gg.maj.clades
  gg.sng.prm <- facet_plot(gg.sng.prm, panel= w, data = agg.sng.param, geom = geom_point, aes(x = get(w), color =  Clade))  +
  scale_color_manual(values = cols[c(3, 9, 6)]) + 
    theme(legend.position = c(.15,.8), legend.background = element_rect(fill = "transparent"))
  
  # hummingbird clades
  gg.sng.prm.hmm <- gg.hmm.clades
  gg.sng.prm.hmm <- facet_plot(gg.sng.prm.hmm, panel = w, data = agg.sng.param.hmm, geom=geom_point, aes(x= get(w), color =  Clade))  +
  scale_color_manual(values = cols[c(3:10)]) +
    theme(legend.position = c(.1,.8),   legend.background = element_rect(fill = "transparent"))
 
### add violin plots  
  # major clades  
 # rename to avoid overwritting 
  gg.sng.prm.maj.clds <- gg.major.clade.collapse.tree
  agg.sng.param.maj.clds <- agg.sng.param
  
  # change species name
  agg.sng.param.maj.clds$species <- agg.sng.param.maj.clds$Clade
  
  # add facet violin
  gg.sng.prm.maj.clds <- facet_plot(gg.sng.prm.maj.clds, panel = w, data = agg.sng.param.maj.clds, geom = geom_violin, aes(x= get(w), group = label), fill = adjustcolor("gray", alpha.f = 0.5))  +
    theme(legend.position = c(.1,.9), legend.background = element_rect(fill = "transparent"))
  
  # hummingbird clades  
 # rename to avoid overwritting 
  gg.sng.prm.hmm.clds <- gg.hmm.clade.collapse.tree
  agg.sng.param.hmm.clds <- agg.sng.param.hmm
  
  # change species name
  agg.sng.param.hmm.clds$species <- agg.sng.param.hmm.clds$Clade
  
  # add facet violin
  gg.sng.prm.hmm.clds <- facet_plot(gg.sng.prm.hmm.clds, panel = w, data = agg.sng.param.hmm.clds, geom = geom_violin, aes(x= get(w), group = label), fill = adjustcolor("gray", alpha.f = 0.5))  +
    theme(legend.position = "none", legend.background = element_rect(fill = "transparent"))
  
 # plot both together
  print(plot_grid(gg.sng.prm, gg.sng.prm.hmm, gg.sng.prm.maj.clds, gg.sng.prm.hmm.clds, ncol = 2))   
  
  }

## [1] "meanfreq"

## [1] "sd"

## [1] "freq.median"

## [1] "freq.Q25"

## [1] "freq.Q75"

## [1] "freq.IQR"

## [1] "time.median"

## [1] "time.Q25"

## [1] "time.Q75"

## [1] "time.IQR"

## [1] "skew"

## [1] "kurt"

## [1] "sp.ent"

## [1] "time.ent"

## [1] "entropy"

## [1] "sfm"

## [1] "meandom"

## [1] "mindom"

## [1] "maxdom"

## [1] "dfrange"

## [1] "modindx"

## [1] "startdom"

## [1] "enddom"

## [1] "dfslope"

## [1] "meanpeakf"

## [1] "elm.duration"

## [1] "freq.range"

## [1] "song.duration"

Song complexity parameters

for(w in names(agg.cmplx.param)[-c(1, 2)]){

  print(w)
  
  # major clades
  gg.cmplx.prm <- gg.maj.clades
  gg.cmplx.prm <- facet_plot(gg.cmplx.prm, panel= w, data = agg.cmplx.param, geom = geom_point, aes(x = get(w), color =  Clade))  +
  scale_color_manual(values = cols[c(3, 9, 6)]) + 
    theme(legend.position = c(.15,.8), legend.background = element_rect(fill = "transparent"))
  
  # hummingbird clades
  gg.cmplx.prm.hmm <- gg.hmm.clades
  gg.cmplx.prm.hmm <- facet_plot(gg.cmplx.prm.hmm, panel = w, data = agg.cmplx.param.hmm, geom=geom_point, aes(x= get(w), color =  Clade))  +
  scale_color_manual(values = cols[c(3:10)]) +
    theme(legend.position = c(.1,.8),   legend.background = element_rect(fill = "transparent"))
  
### add violin plots  
  # major clades  
 # rename to avoid overwritting 
  gg.sng.cmplx.maj.clds <- gg.major.clade.collapse.tree
  agg.sng.cmplx.maj.clds <- agg.cmplx.param
  
  # change species name
  agg.sng.cmplx.maj.clds$species <- agg.sng.cmplx.maj.clds$Clade
  
  # add facet violin
  gg.sng.cmplx.maj.clds <- facet_plot(gg.sng.cmplx.maj.clds, panel = w, data = agg.sng.cmplx.maj.clds, geom = geom_violin, aes(x= get(w), group = label), fill = adjustcolor("gray", alpha.f = 0.5))  +
    theme(legend.position = c(.1,.9), legend.background = element_rect(fill = "transparent"))
  
  # hummingbird clades  
 # rename to avoid overwritting 
  gg.sng.cmplx.hmm.clds <- gg.hmm.clade.collapse.tree
  agg.sng.cmplx.hmm.clds <- agg.cmplx.param.hmm
  
  # change species name
  agg.sng.cmplx.hmm.clds$species <- agg.sng.cmplx.hmm.clds$Clade
  
  # add facet violin
  gg.sng.cmplx.hmm.clds <- facet_plot(gg.sng.cmplx.hmm.clds, panel = w, data = agg.sng.cmplx.hmm.clds, geom = geom_violin, aes(x= get(w), group = label), fill = adjustcolor("gray", alpha.f = 0.5))  +
    theme(legend.position = "none", legend.background = element_rect(fill = "transparent"))
  
 # plot both together
  print(plot_grid(gg.cmplx.prm, gg.cmplx.prm.hmm, gg.sng.cmplx.maj.clds, gg.sng.cmplx.hmm.clds, ncol = 2))   
  
}

## [1] "elm.types"

## [1] "sq.complx"

## [1] "acous.spc"

## [1] "btwn.song.var"

## [1] "pca.complx"

## [1] "btwn.song.var.IMP"

---

R session information

## R version 3.6.1 (2019-07-05)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Ubuntu 18.04.4 LTS
## 
## Matrix products: default
## BLAS:   /usr/lib/x86_64-linux-gnu/atlas/libblas.so.3.10.3
## LAPACK: /usr/lib/x86_64-linux-gnu/atlas/liblapack.so.3.10.3
## 
## locale:
##  [1] LC_CTYPE=es_ES.UTF-8       LC_NUMERIC=C              
##  [3] LC_TIME=es_CR.UTF-8        LC_COLLATE=es_ES.UTF-8    
##  [5] LC_MONETARY=es_CR.UTF-8    LC_MESSAGES=es_ES.UTF-8   
##  [7] LC_PAPER=es_CR.UTF-8       LC_NAME=C                 
##  [9] LC_ADDRESS=C               LC_TELEPHONE=C            
## [11] LC_MEASUREMENT=es_CR.UTF-8 LC_IDENTIFICATION=C       
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
## [1] cowplot_1.0.0     ggtree_2.1.3      phytools_0.6-99   maps_3.3.0       
## [5] ape_5.3           kableExtra_1.1.0  viridis_0.5.1     viridisLite_0.3.0
## [9] ggplot2_3.3.0    
## 
## loaded via a namespace (and not attached):
##  [1] Rcpp_1.0.3              lattice_0.20-40         tidyr_1.0.0            
##  [4] gtools_3.8.1            assertthat_0.2.1        zeallot_0.1.0          
##  [7] digest_0.6.22           R6_2.4.1                backports_1.1.5        
## [10] evaluate_0.14           coda_0.19-3             httr_1.4.1             
## [13] pillar_1.4.2            rlang_0.4.1             lazyeval_0.2.2         
## [16] rstudioapi_0.10         phangorn_2.5.5          Matrix_1.2-18          
## [19] combinat_0.0-8          rmarkdown_1.17          labeling_0.3           
## [22] webshot_0.5.1           readr_1.3.1             stringr_1.4.0          
## [25] igraph_1.2.4.1          munsell_0.5.0           compiler_3.6.1         
## [28] numDeriv_2016.8-1.1     xfun_0.12               pkgconfig_2.0.3        
## [31] mnormt_1.5-5            htmltools_0.4.0         tidyselect_0.2.5       
## [34] tibble_2.1.3            gridExtra_2.3           expm_0.999-4           
## [37] quadprog_1.5-8          crayon_1.3.4            dplyr_0.8.3            
## [40] withr_2.1.2             MASS_7.3-51.4           grid_3.6.1             
## [43] jsonlite_1.6            lifecycle_0.1.0         nlme_3.1-142           
## [46] gtable_0.3.0            magrittr_1.5            scales_1.0.0           
## [49] tidytree_0.3.2          stringi_1.4.6           scatterplot3d_0.3-41   
## [52] xml2_1.2.2              rvcheck_0.1.8           vctrs_0.2.0            
## [55] fastmatch_1.1-0         treeio_1.10.0           tools_3.6.1            
## [58] glue_1.3.1              purrr_0.3.3             hms_0.5.2              
## [61] plotrix_3.7-6           parallel_3.6.1          yaml_2.2.1             
## [64] colorspace_1.4-1        BiocManager_1.30.10     rvest_0.3.5            
## [67] animation_2.6           clusterGeneration_1.3.4 knitr_1.28